home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 174 / 174.d81 / sundial maker (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  3KB  |  116 lines
  1. 5 poke55,.:poke56,56:clr
  2. 10 dv=peek(186):ifdv<8thendv=8
  3. 15 poke53280,0:poke53281,0:print"[147]"
  4. 16 poke53371,0
  5. 30 ad=49152
  6. 35 sysad:sysad+12
  7. 38 bx$="[158]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_"
  8. 40 sysad+9,15:poke53272,31
  9. 42 print"[147][158]^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^"
  10. 43 printbx$;""tab(38)bx$
  11. 44 print"[158]^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^"
  12. 45 print"":printtab(5)"[158] [214][197][210][212][201][195][193][204] [211][213][206][196][201][193][204] [195][193][204][195][213][204][193][212][207][210] "
  13. 50 print:printtab(7)"[153][217]our [204]atitude:";:l9%=6:gosub500:b=q9
  14. 52 print:printtab(7)"[153][217]our [204]ongitude:";:l9%=6:gosub500:l=q9
  15. 55 ifb<0 thenprint"[145][145]":goto50
  16. 60 print:printtab(7)"[153][212]ime-zone [205]eridian:";:l9%=3:gosub500:l0=q9
  17. 65 print:printtab(7)"[153][193]zimuth [196]ial [198]aces:";:l9%=6:gosub500:f=q9
  18. 70 iff<=90orf>=270thenprint"[145][145]":goto65
  19. 75 p1=3.14159265:r1=p1/180
  20. 80 b1=b*r1:s=0
  21. 85 print:printtab(7)"[153][211]un [197][153]ast or [215][153]est":ct=0
  22. 86 gets$:ifs$<>"e"ands$<>"w"then86
  23. 88 sysad+9,16
  24. 90 ifs$="e"thens=-1
  25. 95 ifs$="w"thens=1
  26. 105 print:printtab(7)"[153][196]ial [200]eight:";:l9%=3:gosub500:h5=q9
  27. 110 print:printtab(7)"[153][215]idth of [212]his [208]art:";:l9%=3:gosub500:w5=q9
  28. 115 print:printtab(7)"[153][211]tep [211]ize in [205]inutes:";:l9%=2:gosub500:g=q9
  29. 116 print:printtab(8)"[159][201]s this correct? [217]/[206]":poke198,0
  30. 117 gethc$:ifhc$<>"y"andhc$<>"n"then117
  31. 118 ifhc$="n"then40
  32. 120 f1=p1/2+s*r1*(180-f):print
  33. 125 r5=w5/h5:z5=s*r1*(l0-l)
  34. 130 print"[147][153][204]at:";b"[153] [204]ong:";l;
  35. 135 print"[153] [205]erid:";l0
  36. 140 print"[153] [196]ial [198]aces [193]zimuth";f
  37. 145 gosub360
  38. 150 print"[153][211]un";s;"  ";w5;
  39. 155 print"[153][215]ide by";h5;"[153][200]igh[158]"
  40. 160 h=12-s:g=s*g/60
  41. 165 :
  42. 170 ifct=18thengosub600
  43. 172 rem calculate loop
  44. 175 q=z5+s*p1*(h-12)/12
  45. 180 ifq<0then230
  46. 185 ifh<4orh>20then235
  47. 190 ifq<>0then200
  48. 195 k=0:goto220
  49. 200 k0=sin(f1)*tan(p1/2-q)
  50. 205 k1=cos(f1)*sin(b1)+k0
  51. 210 ifk1=0thenk1=1e-10
  52. 215 k=cos(b1)/k1
  53. 220 gosub255
  54. 225 ifk>=0thengosub280
  55. 230 h=h+g:goto170
  56. 235 gosub3000
  57. 245 s=0:goto85
  58. 250 :
  59. 255 rem decide x or y
  60. 260 d=s*k*h5:d$="  x="
  61. 265 ifk<r5then275
  62. 270 d=-w5/k:d$="  *y="
  63. 275 return
  64. 280 ct=ct+1:rem print a line
  65. 285 h0=h+.002
  66. 290 h1=int(h0):m1=int(60*(h0-h1))
  67. 295 m1$=str$(100+m1)
  68. 300 m1$="[158]:"+right$(m1$,2)
  69. 305 p$=" pm "
  70. 310 ifh1<12thenp$=" am "
  71. 315 ifh1<>12then325
  72. 320 ifm1=0thenp$=" noon "
  73. 325 ifh1>12thenh1=h1-12
  74. 330 h1$=str$(h1)
  75. 335 ifh1<10thenh1$=" "+h1$
  76. 340 d=int(d*1000+.5)/1000
  77. 345 printh1$;m1$;p$;
  78. 350 printtab(15);d$;d
  79. 355 return
  80. 360 rem compute end of style
  81. 365 p5=tan(p1/2-b1)*h5
  82. 370 z=sin(f1)*p5
  83. 375 z=int(z*1000+.5)/1000
  84. 380 x=s*tan(p1/2-f1)*z
  85. 385 x=int(x*1000+.5)/1000
  86. 390 y=-h5
  87. 395 print"[159][211]tyle end [195]oordinates"
  88. 400 print"[159]x=";x"[159], y=";y;"[159], z=";z"[158]"
  89. 405 return
  90. 500 q9$="":poke198,.
  91. 505 geta$
  92. 510 poke646,rnd(1)*15+1:print"*[157]";:ifa$=""then505
  93. 515 ifa$=chr$(13)thenprint" ":q9=val(q9$):return
  94. 520 if(a$=chr$(20)andlen(q9$))thenq9$=left$(q9$,len(q9$)-1):goto550
  95. 525 iflen(q9$)>=l9%thensysad+9,1:goto505
  96. 530 if(a$>="0"anda$<="9")ora$="."ora$="-"ora$="+"then540
  97. 535 goto505
  98. 540 q9$=q9$+a$
  99. 545 print""a$;:sysad+9,16:goto505
  100. 550 print" [157][157] [157]";:goto505
  101. 600 poke214,22:print:printtab(6)"[159][193]ny key to continue":poke198,0
  102. 610 geta$:ifa$=""then610
  103. 615 print"[147]":ct=0:gosub395
  104. 620 return
  105. 3000 print:printtab(3)"[150](1[150]) [207]ther side (2[150]) [211]tart [207]ver
  106. 3010 [153][163]8)"def(3def) (NULL)niverse menu
  107. 3020 poke198,0
  108. 3030 geta$:ifa$<"1"ora$>"3"then3030
  109. 3040 ifa$="1"thenprint"[147]":return
  110. 3045 ifa$="2"then38
  111. 3050 sysad+15
  112. 3060 print"[147][144]load"chr$(34)"b.universe iii"chr$(34)","dv
  113. 3070 print"run28"
  114. 3080 poke631,13:poke632,13:poke198,2:end
  115. 10000 d=peek(186):n$="0:sundial maker":open15,d,15,"s"+n$:close15:saven$,d:end
  116.